;;; hexl+.el --- edit a file in a hex dump format with multiple coding support

;; Copyright 2007 Ye Wenbin
;;
;; Author: wenbinye@163.com
;; Version: $Id: hexl+.el,v 0.0 2007/06/07 02:07:06 ywb Exp $
;; Keywords: 
;; X-URL: not distributed yet

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; FIXME:
;; 1. The mode can't use narrow functions, because all address
;; conversion is calculated by (forward-line address/16)
;;
;; 2. How to insert utf-16 ascii?
;; 

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'hexl+)
;;   or
;;   (autoload 'hexl-mode "hexl+" "Edit a file in a hex dump format" t)
;;
;; If the filter hexl+ is not in `exec-directory', you should set it
;; with full name:
;;   (setq hexl-program "/path/to/hexl+")

;;; Code:

(eval-when-compile
  (require 'cl))

(require 'hexl)

(setq hexl-program "hexl+")
(defvar hexl-cached-data nil)

(defvar hexl-coding-system-alist
  '((chinese-gbk "gbk")
    (chinese-iso-8bit "gb2312")
    (chinese-gb18030 "gb18030")
    (mule-utf-8 "utf-8")
    (undecided "utf-8")))

(defvar hexl-enable-multibyte-p t)

(defun hexl-mode-unibyte (&optional arg)
  (let (hexl-enable-multibyte-p)
    (hexl-mode arg)))

;;;###autoload
(defun hexl-mode (&optional arg)
  "\\<hexl-mode-map>A mode for editing binary files in hex dump format.
This is not an ordinary major mode; it alters some aspects
of the current mode's behavior, but not all; also, you can exit
Hexl mode and return to the previous mode using `hexl-mode-exit'.

This function automatically converts a buffer into the hexl format
using the function `hexlify-buffer'.

Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
values grouped every 16 bits) and as their ASCII values.

If any of the characters (displayed as ASCII characters) are
unprintable (control or meta characters) they will be replaced as
periods.

If `hexl-mode' is invoked with an argument the buffer is assumed to be
in hexl format.

A sample format:

  HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f     ASCII-TEXT
  --------  ---- ---- ---- ---- ---- ---- ---- ----  ----------------
  00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64  This is hexl-mod
  00000010: 652e 2020 4561 6368 206c 696e 6520 7265  e.  Each line re
  00000020: 7072 6573 656e 7473 2031 3620 6279 7465  presents 16 byte
  00000030: 7320 6173 2068 6578 6164 6563 696d 616c  s as hexadecimal
  00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74   ASCII.and print
  00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
  00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
  00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are
  00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
  000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character
  000000c0: 7265 6769 6f6e 2e0a                      region..

Movement is as simple as movement in a normal Emacs text buffer.  Most
cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
to move the cursor left, right, down, and up).

Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
also supported.

There are several ways to change text in hexl mode:

ASCII characters (character between space (0x20) and tilde (0x7E)) are
bound to self-insert so you can simply type the character and it will
insert itself (actually overstrike) into the buffer.

\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
it isn't bound to self-insert.  An octal number can be supplied in place
of another key to insert the octal number's ASCII representation.

\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
into the buffer at the current point.

\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
into the buffer at the current point.

\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
into the buffer at the current point.

\\[hexl-mode-exit] will exit hexl-mode.

Note: saving the file with any of the usual Emacs commands
will actually convert it back to binary format while saving.

You can use \\[hexl-find-file] to visit a file in Hexl mode.

\\[describe-bindings] for advanced commands."
  (interactive "p")
  (unless (eq major-mode 'hexl-mode)
    (let ((modified (buffer-modified-p))
          (inhibit-read-only t)
          (original-point (- (point) (point-min))))
      (and (eobp) (not (bobp))
           (setq original-point (1- original-point)))
      ;; If `hexl-mode' is invoked with an argument the buffer is assumed to
      ;; be in hexl format.
      (when (memq arg '(1 nil))
        ;; If the buffer's EOL type is -dos, we need to account for
        ;; extra CR characters added when hexlify-buffer writes the
        ;; buffer to a file.
        ;; FIXME: This doesn't take into account multibyte coding systems.
        (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
          (setq original-point (+ (count-lines (point-min) (point))
                                  original-point))
          (or (bolp) (setq original-point (1- original-point))))
        (hexlify-buffer)
        (restore-buffer-modified-p modified))

      ;; +: A new function to calculate max address
      (set (make-local-variable 'hexl-max-address) (hexl-max-address))
      (condition-case nil
          (hexl-goto-address original-point)
        (error nil)))
    ;; +: add two buffer local varable
    (set (make-local-variable 'hexl-cached-data) nil)
    (make-local-variable 'hexl-enable-multibyte-p)

    ;; We do not turn off the old major mode; instead we just
    ;; override most of it.  That way, we can restore it perfectly.
    (make-local-variable 'hexl-mode-old-local-map)
    (setq hexl-mode-old-local-map (current-local-map))
    (use-local-map hexl-mode-map)

    (make-local-variable 'hexl-mode-old-mode-name)
    (setq hexl-mode-old-mode-name mode-name)
    (setq mode-name "Hexl")

    (set (make-local-variable 'hexl-mode-old-isearch-search-fun-function)
         isearch-search-fun-function)
    (set (make-local-variable 'isearch-search-fun-function)
         'hexl-isearch-search-function)

    (make-local-variable 'hexl-mode-old-major-mode)
    (setq hexl-mode-old-major-mode major-mode)
    (setq major-mode 'hexl-mode)

    (make-local-variable 'hexl-mode-old-ruler-mode)
    (setq hexl-mode-old-ruler-mode
          (and (boundp 'ruler-mode) ruler-mode))

    (make-local-variable 'hexl-mode-old-hl-line-mode)
    (setq hexl-mode-old-hl-line-mode
          (and (boundp 'hl-line-mode) hl-line-mode))

    (make-local-variable 'hexl-mode-old-syntax-table)
    (setq hexl-mode-old-syntax-table (syntax-table))
    (set-syntax-table (standard-syntax-table))

    (add-hook 'write-contents-functions 'hexl-save-buffer nil t)

    (make-local-variable 'hexl-mode-old-require-final-newline)
    (setq hexl-mode-old-require-final-newline require-final-newline)
    (make-local-variable 'require-final-newline)
    (setq require-final-newline nil)

    (make-local-variable 'hexl-mode-old-font-lock-keywords)
    (setq hexl-mode-old-font-lock-keywords font-lock-defaults)
    (make-local-variable 'font-lock-defaults)
    (setq font-lock-defaults '(hexl-font-lock-keywords t))

    ;; Add hooks to rehexlify or dehexlify on various events.
    (add-hook 'before-revert-hook 'hexl-before-revert-hook nil t)
    (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)

    (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)

    ;; Set a callback function for eldoc.
    (set (make-local-variable 'eldoc-documentation-function)
         'hexl-print-current-point-info)
    (eldoc-add-command-completions "hexl-")
    (eldoc-remove-command "hexl-save-buffer"
                          "hexl-current-address")

    (if hexl-follow-ascii (hexl-follow-ascii 1)))
  (run-mode-hooks 'hexl-mode-hook))

(defun hexl-offset-bytes ()
  (let ((col (- (current-column) 10)))
    (and (>= col 0) (< col 38)
         (/ (- col (/ col 5)) 2))))

(defun hexl-max-address ()
  "Calculate max address using the information given by `hexl-program'."
  (let (base rest)
    (save-excursion
      (goto-char (point-max))
      (forward-line -1)
      (setq base (string-to-number (buffer-substring (point) (+ (point) 8)) 16))
      (re-search-forward "  ")
      (backward-char 4)
      (+ base (hexl-offset-bytes)))))

(defun hexl-address-to-marker (address)
  "Return buffer position for ADDRESS."
  (interactive "nAddress: ")
  (save-excursion
    (let ((base (% address 16)))
      (goto-char (point-min))
      (forward-line (/ address 16))
      (forward-char (+ (* (/ base 2) 5) (* (% base 2) 2) 10))
      (point))))

(defun hexl-marker-to-address (&optional pos)
  "Return address for buffer position"
  (save-excursion
    (and pos (goto-char pos))
    (let ((bytes (hexl-offset-bytes)))
      (when bytes
        (forward-line 0)
        (+ (string-to-number (buffer-substring (point) (+ (point) 8)) 16)
           bytes)))))

;;;###autoload
(defun hexlify-buffer ()
  "Convert a binary buffer to hexl format.
This discards the buffer's undo information."
  (interactive)
  (and (consp buffer-undo-list)
       (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
           (error "Aborted"))
       (setq buffer-undo-list nil))
  ;; Don't decode text in the ASCII part of `hexl' program output.
  (let ((coding-system-for-write buffer-file-coding-system)
        (buffer-undo-list t)
        ;; Manually encode the args, otherwise they're encoded using
        ;; coding-system-for-write (i.e. buffer-file-coding-system) which
        ;; may not be what we want (e.g. utf-16 on a non-utf-16 system).
        (args (mapcar (lambda (s)
                        (if (not (multibyte-string-p s)) s
                          (encode-coding-string s locale-coding-system)))
                      (split-string hexl-options))))
    (if hexl-enable-multibyte-p
        (setq args
              (append args (list "-from" (hexl-convert-coding-system buffer-file-coding-system)
                                 "-to" (hexl-convert-coding-system locale-coding-system)))))
    (apply 'call-process-region (point-min) (point-max)
           (expand-file-name hexl-program exec-directory)
           t t nil args)
    (if (> (point) (hexl-address-to-marker hexl-max-address))
        (hexl-goto-address hexl-max-address))))

(defun hexl-convert-coding-system (coding-system)
  "Convert emacs CODING-SYSTEM name to external command \"iconv\" encodings"
  (setq coding-system (coding-system-base coding-system))
  (let ((alias (assoc coding-system hexl-coding-system-alist)))
    (if alias
        (cadr alias)
      (symbol-name coding-system))))

(defun hexl-current-address (&optional validate)
  "Return current hexl-address."
  (interactive)
  (let ((hexl-address (hexl-marker-to-address)))
    (or hexl-address
        (if validate
            (error "Point is not on a character in the file")))
    (when (interactive-p)
      (message "Current address is %d/0x%08x" hexl-address hexl-address))
    hexl-address))

(defun hexl-beginning-of-line ()
  "Goto beginning of line in hexl mode."
  (interactive)
  (forward-line 0)
  (forward-char 10))

(defun hexl-parse-line ()
  "Parse hex data, find the byte offset of the first character and hex
string for every character in current line. `hexl-cached-data' is list
with data: (LINE-BEGINNING-POSITION OFFSET CHARS-HEX-STRING)

The LINE-BEGINNING-POSITION is used to test whether it is necessary to
recalculate.

OFFSET is the offset first byte of in current to the first character.
for example, a utf-8 character α is encode by \"#xCE #xB1\". If the
first byte in current line is \"ce\", the offset is 0. Otherwise,
the offset is 1.

CHARS-HEX-STRING is a list of all hex string for each characters in
current line."
  (save-excursion
    (forward-line 0)
    (let ((text (buffer-substring (+ (point) 51) (line-end-position)))
          (line (replace-regexp-in-string " " ""
                                          (buffer-substring (+ (point) 10) (+ (point) 50))))
          (coding buffer-file-coding-system)
          (offset 0)
          pattern)
      (setq pattern
            (concat "^" (hexl-hex-string (encode-coding-string (substring text 0 1) coding))))
      ;; if first char match the line from begin, Is it sure that the
      ;; line start at first byte?
      (unless (string-match pattern line)
        (forward-line -1)
        (forward-char 47)
        (while (not (string-match pattern line))
          (setq line (concat (buffer-substring (point) (+ (point) 2)) line)
                offset (+ offset 1))
          (if (= (char-before) ? )
              (backward-char))
          (backward-char 2))
        (forward-line 1))
      (setq hexl-cached-data
            (list (point) offset
                  (mapcar
                   (lambda (c)
                     (hexl-hex-string (encode-coding-string (char-to-string c) coding)))
                   (decode-coding-string (hexl-unhex-string line) coding)))))))

(defun hexl-parse-char ()
  "Return the bytes character position and the offset of the bytes."
  (let ((bytes (hexl-offset-bytes)))
    (when bytes
      (save-excursion
        (forward-line 0)
        (unless (and hexl-cached-data (= (point) (car hexl-cached-data)))
          (hexl-parse-line))
        (let ((data (nth 2 hexl-cached-data))
              (total -2)
              (i 0)
              tmp)
          (setq bytes (+ (* 2 bytes) (* (cadr hexl-cached-data) 2)))
          (while (< total bytes)
            (setq i (1+ i)
                  tmp (car data)
                  total (+ total (length tmp))
                  data (cdr data)))
          (setq i (+ (point) 50 i))
          (if (>= i (line-end-position))
              (let ((diff (- i (line-end-position))))
                (forward-line 1)
                (forward-char 51)
                (cons (point) (* diff 2)))
            (cons i (- (length tmp) (- total bytes) 2))))))))

(defun hexl-follow-ascii-find ()
  "Find and highlight the ASCII element corresponding to current point."
  (let ((pos (hexl-parse-char)))
    (when pos
      (move-overlay hexl-ascii-overlay (car pos) (1+ (car pos)))
      (overlay-put hexl-ascii-overlay 'face
                   (if (= (cdr pos) 0) 'highlight 'hexl-ascii-region)))))

(defun hexl-hex-string (string)
  "Return the hex string of STRING."
  (mapconcat (lambda (c) (format "%02x" c)) string ""))

(defun hexl-unhex-string (string)
  "Return the string converted from a hex string"
  (let* ((i 0)
         (len (length string))
         (hex (make-string (/ len 2) 0)))
    (while (< i len)
      (aset hex (/ i 2) (hexl-htoi (aref string i)
                                   (aref string (1+ i))))
      (setq i (+ i 2)))
    hex))

(defun hexl-insert-char (ch num)
  "Insert the character CH NUM times in a hexl buffer.

CH must be a unibyte character whose value is between 0 and 255."
  (if (or (< ch 0) (> ch 255))
      (error "Invalid character 0x%x -- must be in the range [0..255]" ch))
  (let ((address (hexl-current-address t)))
    (while (and (> num 0) (<= address hexl-max-address))
      (hexl-goto-address address)
      (let ((data (hexl-parse-char)))
        (if (= (string-to-char (hexl-printable-character
                                (string-to-number (buffer-substring (point) (+ (point) 2)) 16)))
               (char-after (car data)))
            (progn
              (delete-char 2)
              (insert (format "%02x" ch))
              (goto-char (car data))
              (delete-char 1)
              (insert (hexl-printable-character ch))
              (setq num (- num 1)
                    address (1+ address)))
          (error "Can't replace a multibyte character"))))
    (hexl-goto-address (min address hexl-max-address))))

(defun hexl-insert-multibyte-char (ch num)
  "Insert a possibly multibyte character CH NUM times.

Non-ASCII characters are first encoded with `buffer-file-coding-system',
and their encoded form is inserted byte by byte.

NOTE: Nonencodable character can not insert now. The multibyte
character will insert only when the character under cursor is equal
length to insert character after encode. That is to say that you can
not replace a multibyte character with ascii, or replace ascii with
multibyte character."
  (let ((charset (char-charset ch))
        (coding (if (or (null buffer-file-coding-system)
                        ;; coding-system-type equals t means undecided.
                        (eq (coding-system-type buffer-file-coding-system) t))
                    default-buffer-file-coding-system
                  buffer-file-coding-system)))
    (cond ((and (> ch 0) (< ch 256))
           (hexl-insert-char ch num))
          ((eq charset 'unknown)
           (error
            "0x%x -- invalid character code; use \\[hexl-insert-hex-string]"
            ch))
          (t
           (let ((encoded (encode-coding-char ch coding))
                 (address (hexl-current-address))
                 data)
             (if (null encoded)
                 (message "Can't encode %c using %S" ch coding)
               (setq data (hexl-parse-char))
               (or (= (cdr data) 0) (hexl-goto-address (setq address (- address (/ (cdr data) 2)))))
               (while (> num 0)
                 (setq data (hexl-parse-char))
                 (if (/= (length (encode-coding-string (char-to-string (char-after (car data))) coding))
                         (length encoded))
                     (error "Can't replace %c which not has equal bytes as %c" (char-after (car data)) ch)
                   (mapc (lambda (c)
                           (delete-char 2)
                           (insert (format "%02x" c))
                           (hexl-goto-address (setq address (1+ address))))
                         encoded)
                   (goto-char (car data))
                   (delete-char 1)
                   (insert-char ch 1)
                   (hexl-goto-address address))
                 (setq num (1- num)))))))))
(provide 'hexl+)
;;; hexl+.el ends here
